home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / totsrc.zip / TOTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  53KB  |  1,978 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.00                             }
  6.  
  7. Unit totLIST;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.  
  13.  
  14. }
  15. INTERFACE
  16.  
  17. Uses DOS,
  18.      totSYS, totLOOK, totFAST, totWIN, totINPUT, totLINK, totSTR, totIO1;
  19.  
  20. TYPE
  21. tListAction = (Finish,Refresh,None);
  22. ListCharFunc = function(var K:word; var X,Y: byte; HiPick:longint): tListAction;
  23. ListMsgFunc = function(HiPick:longint):string;
  24.  
  25. pBrowseOBJ = ^BrowseOBJ;
  26. BrowseOBJ = object
  27.    vWin: StretchWinPtr;
  28.    vTopPick: longint;         {number of first pick in window}
  29.    vTotPicks: longint;        {total number of picks}
  30.    vListVisible: boolean;     {is list on display}
  31.    vListAssigned: boolean;    {is data assigned to list}
  32.    vActivePick: integer;      {the offset of the active pick from the top}
  33.    vRows: integer;            {total number of visible rows}
  34.    vStartCol : longint;       {string position of first character}
  35.    vEndCol: longint;          {rightmost column for scrolling}
  36.    vRealColWidth: byte;       {max avail column width}
  37.    vLastKey: word;            {last key the user pressed}
  38.    {methods ...}
  39.    constructor Init;
  40.    procedure   SetTopPick(TopPick: longint);
  41.    procedure   SetStartCol(Column: longint);
  42.    procedure   SetEndCol(Column: longint);
  43.    function    Win:StretchWinPtr;
  44.    procedure   DisplayPick(Pick:integer);
  45.    procedure   DisplayAllPicks;
  46.    procedure   ScrollUp;
  47.    procedure   ScrollDown;
  48.    procedure   ScrollPgUp;
  49.    procedure   ScrollPgDn;
  50.    procedure   ScrollFirst;
  51.    procedure   ScrollLast;
  52.    procedure   SlideLeft;
  53.    procedure   SlideRight;
  54.    procedure   ScrollFarRight;
  55.    procedure   ScrollFarLeft;
  56.    procedure   ScrollJumpH(X,Y:byte);
  57.    procedure   ScrollJumpV(X,Y:byte);
  58.    function    LastKey: word;
  59.    procedure   Remove;
  60.    procedure   Show;
  61.    procedure   ResetDimensions;
  62.    procedure   Go;
  63.    function    GetString(Pick, Start,Finish: longint):string;  VIRTUAL;
  64.    destructor  Done;                                           VIRTUAL;
  65. end; {BrowseOBJ}
  66.  
  67. pBrowseArrayOBJ = ^BrowseArrayOBJ;
  68. BrowseArrayOBJ = Object (BrowseOBJ)
  69.    vArrayPtr: pointer;
  70.    vStrLength: byte;
  71.    {methods ...}
  72.    constructor Init;
  73.    procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
  74.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  75.    destructor  Done;                                           VIRTUAL;
  76. end; {BrowseArrayOBJ}
  77.  
  78. pBrowseLinkOBJ = ^BrowseLinkOBJ;
  79. BrowseLinkOBJ = Object (BrowseOBJ)
  80.    vLinkList: ^DLLOBJ;
  81.    {methods ...}
  82.    constructor Init;
  83.    procedure   AssignList(var LinkList: DLLOBJ);
  84.    function    ListPtr: DLLPtr;
  85.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  86.    destructor  Done;    VIRTUAL;
  87. end; {BrowseLinkOBJ}
  88.  
  89. pBrowseFileOBJ = ^BrowseFileOBJ;
  90. BrowseFileOBJ = Object (BrowseOBJ)
  91.    vStrList: ^StrDLLOBJ;
  92.    {methods ...}
  93.    constructor Init;
  94.    function    AssignFile(Filename: string):integer;
  95.    function    ListPtr: StrDLLPtr;
  96.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  97.    destructor  Done;    VIRTUAL;
  98. end; {BrowseFileOBJ}
  99.  
  100. pListOBJ = ^ListOBJ;
  101. ListOBJ = object
  102.    vWin: StretchWinPtr;       {pointer to a window}
  103.    vMargin: tByteCoords;      {padding around window border}
  104.    vZone: tByteCoords;        {outer window dimensions}
  105.    vTopPick: longint;         {number of first pick in window}
  106.    vTotPicks: longint;        {total number of picks}
  107.    vAllowToggle: boolean;     {can user select items in list}
  108.    vListVisible: boolean;     {is list on display}
  109.    vListAssigned: boolean;    {is data assigned to list}
  110.    vLastChar: word;           {last key user pressed}
  111.    vColWidth: byte;           {user set column width in list display: 0 = max}
  112.    vNAttr: byte;              {normal attribute/color}
  113.    vSAttr: byte;              {attribute for special items}
  114.    vHAttr: byte;              {highlighted topic attribute/color}
  115.    vActivePick: integer;      {the offset of the active pick from the top}
  116.    vRows: integer;            {total number of visible rows}
  117.    vCols: integer;            {Total number of visible columns}
  118.    vRealColWidth: byte;       {max avail column width}
  119.    vLastColWidth: byte;       {width of right most column}
  120.    vUseLastCol: boolean;      {use the last column for highlighting or too narrow}
  121.    vLastKey: word;            {last key the user pressed}
  122.    vCharHook: ListCharFunc;   {character hook}
  123.    vMsgHook: ListMsgFunc;     {message hook}
  124.    vMsgActive: boolean;       {is Msg hook enabled}
  125.    vDualColors: boolean;      {should list use SAttr and NAttr}
  126.    {methods ...}
  127.    constructor Init;
  128.    procedure   SetTopPick(TopPick: longint);
  129.    procedure   SetActivePick(ThePick: LongInt);
  130.    procedure   SetTagging(On:boolean);
  131.    procedure   SetColors(HAttr,NAttr,SAttr: byte);
  132.    procedure   SetColWidth(Wid: byte);
  133.    procedure   SetCharHook(Func:ListCharFunc);
  134.    procedure   SetMsgHook(Func:ListMsgFunc);
  135.    procedure   SetMsgState(On:boolean);
  136.    procedure   SetDualColors(On:Boolean);
  137.    function    GetHiString:string;
  138.    function    Win:StretchWinPtr;
  139.    procedure   ResetDimensions;
  140.    procedure   DisplayPick(Pick:integer; Hi:boolean);
  141.    procedure   DisplayAllPicks;
  142.    procedure   RefreshList;
  143.    procedure   Remove;
  144.    procedure   ValidateActivePick;
  145.    procedure   ScrollUp;
  146.    procedure   ScrollDown;
  147.    procedure   JumpEngine(Tot, NewValue: longint);
  148.    procedure   ScrollJumpV(X,Y:byte);
  149.    procedure   ScrollJumpH(X,Y:byte);
  150.    procedure   ScrollLeft;
  151.    procedure   ScrollFarLeft;
  152.    procedure   ScrollRight;
  153.    procedure   ScrollFarRight;
  154.    procedure   ScrollPgDn;
  155.    procedure   ScrollPgUp;
  156.    procedure   ScrollFirst;
  157.    procedure   ScrollLast;
  158.    procedure   ToggleSelect;
  159.    function    TargetPick(X,Y:byte): Integer;
  160.    procedure   MouseChoose(KeyX,KeyY:byte);
  161.    function    LastKey: word;
  162.    procedure   Go;
  163.    procedure   Show;
  164.    function    CharTask(var K:word; var X,Y: byte; 
  165.                         HiPick:longint): tListAction;          VIRTUAL;
  166.    function    MessageTask(HiPick:longint):string;             VIRTUAL;
  167.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  168.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  169.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  170.    procedure   TagAll(On:boolean);                             VIRTUAL;
  171.    destructor  Done;                                           VIRTUAL;
  172. end; {ListOBJ}
  173.  
  174. pListArrayOBJ = ^ListArrayOBJ;
  175. ListArrayOBJ = object (ListOBJ)
  176.    vArrayPtr: pointer;
  177.    vStrLength: byte;
  178.    vLinkList: ^DLLOBJ;
  179.    {methods ...}
  180.    constructor Init;
  181.    procedure  AssignList(var StrArray; Total:Longint; StrLength:byte;Selectable: boolean);
  182.    procedure  SetTagging(On:boolean);
  183.    function   GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  184.    function   GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  185.    procedure  SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  186.    procedure  TagAll(On:boolean);                             VIRTUAL;
  187.    destructor Done;                                           VIRTUAL;
  188. end; {of object ListArrayOBJ}
  189.  
  190. pListLinkOBJ = ^ListLinkOBJ;
  191. ListLinkOBJ = object (ListOBJ)
  192.    vLinkList: ^DLLOBJ;
  193.    {methods ...}
  194.    constructor Init;
  195.    procedure   AssignList(var LinkList: DLLOBJ);
  196.    function    ListPtr: DLLPtr;
  197.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  198.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  199.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  200.    procedure   TagAll(On:boolean);                             VIRTUAL;
  201.    destructor  Done;                                           VIRTUAL;
  202. end; {ListLinkOBJ}
  203.  
  204. pListDirOBJ = ^ListDirOBJ;
  205. ListDirOBJ = object (ListOBJ)
  206.    vFileList: ^FileDLLOBJ;
  207.    vActiveDir: PathStr;
  208.    {methods ...}
  209.    constructor Init;
  210.    procedure   ReadFiles(FileMasks:string; FileAttrib: word);
  211.    function    GetHiString: string;
  212.    procedure   Go;
  213.    function    FileList:FileDLLPtr;
  214.    function    CharTask(var K:word; var X,Y: byte;
  215.                         HiPick:longint): tListAction;          VIRTUAL;
  216.    function    MessageTask(Hi:longint): string;                VIRTUAL;
  217.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  218.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  219.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  220.    procedure   TagAll(On:boolean);                             VIRTUAL;
  221.    destructor  Done;                                           VIRTUAL;
  222. end; {ListDirOBJ}
  223.  
  224. pListDirSortOBJ = ^ListDirSortOBJ;
  225. ListDirSortOBJ = object (ListDirOBJ)
  226.    constructor Init;
  227.    function    PromptAndSort: boolean;
  228.    function    CharTask(var K:word; var X,Y: byte;
  229.                         HiPick:longint): tListAction;          VIRTUAL;
  230.    destructor  Done;                                           VIRTUAL;
  231. end; {ListDirSortOBJ}
  232. procedure ListInit;
  233.  
  234. IMPLEMENTATION
  235. {|||||||||||||||||||||||||||||||||||||||||||||}
  236. {                                             }
  237. {     M i s c.  P r o c s   &   F u n c s     }
  238. {                                             }
  239. {|||||||||||||||||||||||||||||||||||||||||||||}
  240. {$F+}
  241. function NoCharHook(var K:word; var X,Y: byte; HiPick:longint): tListAction;
  242. {}
  243. begin
  244.    NoCharHook := None;
  245. end; {NoCharHook}
  246.  
  247. function NoMsgHook(HiPick:longint):string;
  248. {}
  249. begin
  250.    NoMsgHook := '';
  251. end; {NoEnterHook}
  252. {$IFNDEF OVERLAY}
  253.    {$F-}
  254. {$ENDIF}
  255.  
  256. procedure Error(Err:byte);
  257. {routine to display error}
  258. const
  259.    Header = 'totLIST error: ';
  260. var
  261.    Msg : string;
  262. begin
  263.    Case Err of
  264.    1: Msg := 'A list Must be assigned before calling SHOW or GO';
  265.    else  Msg := 'Unknown Error';
  266.    end; {case}
  267.    Writeln(Header,Msg);
  268. {Maybe Add non-fatal compiler directive}
  269.    halt;
  270. end; {Error}
  271. {||||||||||||||||||||||||||||||||||||||||||}
  272. {                                          }
  273. {    B r o w s e O B J   M E T H O D S     }
  274. {                                          }
  275. {||||||||||||||||||||||||||||||||||||||||||}
  276. constructor BrowseOBJ.Init;
  277. {}
  278. begin
  279.    new(vWin,Init);
  280.    vWin^.SetScrollable(true,true);
  281.    vTopPick := 1;
  282.    vTotPicks := 1;
  283.    vListAssigned := false;
  284.    vListVisible := false;
  285.    vStartCol := 1;
  286.    vEndCol := 80;
  287.    vActivePick := 1;
  288.    vRows := 0;
  289. end; {BrowseOBJ.Init}
  290.  
  291. function BrowseOBJ.Win:StretchWinPtr;
  292. {}
  293. begin
  294.    Win := vWin;
  295. end; {BrowseOBJ.Win}
  296.  
  297. procedure BrowseOBJ.SetTopPick(TopPick: longint);
  298. {}
  299. begin
  300.    vTopPick := TopPick;
  301. end; {BrowseOBJ.SetTopElement}
  302.  
  303. procedure BrowseOBJ.SetStartCol(Column: longint);
  304. {}
  305. begin
  306.    vStartCol := Column;
  307. end; {BrowseOBJ.SetStartCol}
  308.  
  309. procedure BrowseOBJ.SetEndCol(Column: longint);
  310. {}
  311. begin
  312.    if (Column > vStartCol) or (Column = 0) then
  313.       vEndCol := Column
  314.    else
  315.       vEndCol := vStartCol;
  316. end; {BrowseOBJ.SetEndCol}
  317.  
  318. function BrowseOBJ.GetString(Pick, Start,Finish: longint):string;
  319. {abstract}
  320. begin end;
  321.  
  322. procedure BrowseOBJ.DisplayPick(Pick:integer);
  323. {}
  324. var
  325.   PickStr: string;
  326. begin
  327.    if pred(vTopPick + Pick) <= vTotPicks then
  328.       PickStr := GetString(pred(vTopPick + Pick),vStartCol,pred(vStartCol)+vRealColWidth)
  329.    else
  330.       PickStr := '';
  331.    PickStr := padleft(PickStr,vRealColWidth,' ');
  332.    Screen.WritePlain(1,Pick,PickStr);
  333. end; {BrowseOBJ.DisplayPick}
  334.  
  335. procedure BrowseOBJ.DisplayAllPicks;
  336. {}
  337. var I : integer;
  338. begin
  339.    for I := 1 to vRows do
  340.        DisplayPick(I);
  341. end; {BrowseOBJ.DisplayAllPicks}
  342.  
  343. procedure BrowseOBJ.ScrollUp;
  344. {}
  345. begin
  346.   if vTopPick > 1 then
  347.   begin
  348.      dec(vTopPick);
  349.      DisplayAllPicks;
  350.   end;
  351. end; {BrowseOBJ.ScrollUp}
  352.  
  353. procedure BrowseOBJ.ScrollDown;
  354. {}
  355. begin
  356.    if vTopPick < vTotPicks then
  357.    begin
  358.       inc(vTopPick);
  359.       DisplayAllPicks;
  360.    end;
  361. end; {BrowseOBJ.ScrollDown}
  362.  
  363. procedure BrowseOBJ.SlideLeft;
  364. {}
  365. begin
  366.    if vStartCol > 1 then
  367.    begin
  368.       dec(vStartCol);
  369.       DisplayAllPicks;
  370.    end;                      
  371. end; {BrowseOBJ.SlideLeft}
  372.  
  373. procedure BrowseOBJ.SlideRight;
  374. {}
  375. begin
  376.    if (vEndCol = 0) or (vStartCol < vEndCol) then
  377.    begin
  378.       inc(vStartCol);
  379.       DisplayAllPicks;
  380.    end;
  381. end; {BrowseOBJ.SlideRight}
  382.  
  383. procedure BrowseOBJ.ScrollPgUp;
  384. {}
  385. begin
  386.    if vTopPick > 1 then
  387.    begin
  388.       dec(vTopPick,vRows);
  389.       if vTopPick < 1 then
  390.          vTopPick := 1;
  391.       DisplayAllPicks;
  392.    end;
  393. end; {BrowseOBJ.ScrollPgUp}
  394.  
  395. procedure BrowseOBJ.ScrollPgDn;
  396. {}
  397. begin
  398.    if pred(vTopPick + vRows) < vTotPicks then
  399.    begin
  400.       inc(vTopPick,vRows);
  401.       DisplayAllPicks;
  402.    end;
  403. end; {BrowseOBJ.ScrollPgDn}
  404.  
  405. procedure BrowseOBJ.ScrollFarRight;
  406. {}
  407. var EndCol: longint;
  408. begin
  409.    if (vEndCol = 0) then
  410.       EndCol := 255
  411.    else
  412.       EndCol := vEndCol;
  413.    if (vStartCol < EndCol - pred(vRealColWidth)) then
  414.    begin
  415.       vStartCol := EndCol - pred(vRealColWidth);
  416.       DisplayAllPicks;
  417.    end;
  418. end; {BrowseOBJ.ScrollFarRight}
  419.  
  420. procedure BrowseOBJ.ScrollFarLeft;
  421. {}
  422. begin
  423.    if vStartCol > 1 then
  424.    begin
  425.       vStartCol := 1;
  426.       DisplayAllPicks;
  427.    end; 
  428. end; {BrowseOBJ.ScrollFarLeft}
  429.  
  430. procedure BrowseOBJ.ScrollLast;
  431. {}
  432. begin
  433.    if pred(vTopPick) + vRows <> vTotPicks then
  434.    begin
  435.       vTopPick := succ(vTotPicks) - vRows;
  436.       DisplayAllPicks;
  437.    end;
  438. end; {BrowseOBJ.ScrollLast}
  439.  
  440. procedure BrowseOBJ.ScrollFirst;
  441. {}
  442. begin
  443.    if vTopPick <> 1 then
  444.    begin
  445.       vTopPick := 1;
  446.       DisplayAllPicks;
  447.    end;
  448. end; {BrowseOBJ.ScrollFirst}
  449.  
  450. procedure BrowseOBJ.ScrollJumpH(X,Y:byte);
  451. {}
  452. var NewStart: longint;
  453. begin
  454.    if X = 1 then
  455.       NewStart := 1
  456.    else if X=Y then
  457.       NewStart := vEndCol
  458.    else
  459.       NewStart := (X * vEndCol) div Y;
  460.    if NewStart <> vStartCol then
  461.    begin
  462.       vStartCol := NewStart;
  463.       DisplayAllPicks;
  464.    end;
  465. end; {BrowseOBJ.ScrollJumpH}
  466.  
  467. procedure BrowseOBJ.ScrollJumpV(X,Y:byte);
  468. {}
  469. var NewTop: longint;
  470. begin
  471.    if X = 1 then
  472.       NewTop := 1
  473.    else if X=Y then
  474.       NewTop := vTotPicks
  475.    else
  476.       NewTop := (X * vTotPicks) div Y;
  477.    if NewTop <> vTopPick then
  478.    begin
  479.       vTopPick := NewTop;
  480.       DisplayAllPicks;
  481.    end;
  482. end; {BrowseOBJ.ScrollJumpV}
  483.  
  484. procedure BrowseOBJ.Go;
  485. {}
  486. var
  487.    Finished: boolean;
  488.    Mvisible: boolean;
  489.    K: word;
  490.    X,Y :byte;
  491.    CX,CY,CT,CB:byte;
  492. begin
  493.    Mvisible := Mouse.Visible;
  494.    if Monitor^.ColorOn then
  495.       with Screen do
  496.       begin
  497.          CursSave;
  498.          CX := WhereX;
  499.          CY := WhereY;
  500.          CT := CursTop;
  501.          CB := CursBot;
  502.          CursOff;
  503.       end;
  504.    Show;
  505.    Finished := false;
  506.    repeat
  507.       vWin^.DrawHorizBar(vStartCol,vEndCol);
  508.       vWin^.DrawVertBar(vTopPick,vTotPicks);
  509.       K := Key.GetKey;
  510.       X := Key.LastX;
  511.       Y := Key.LastY;
  512.       vWin^.Winkey(K,X,Y);
  513.       if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
  514.          Finished := true
  515.       else
  516.          case K of
  517.          600: Finished := true; {window close}
  518.          602: begin
  519.             ResetDimensions;
  520.             DisplayAllPicks; {window stretched}
  521.             end;
  522.          610,328: ScrollUp;
  523.          611,336: ScrollDown;
  524.          612,331: SlideLeft;
  525.          613,333: SlideRight;
  526.          337: ScrollPgDn;
  527.          329: ScrollPgUp;
  528.          335: ScrollFarRight;
  529.          327: ScrollFarLeft;
  530.          388: ScrollFirst;
  531.          374: ScrollLast;
  532.          614: ScrollJumpV(X,Y);
  533.          615: ScrollJumpH(X,Y);
  534.          end; {case}
  535.    until Finished;
  536.    vLastKey := K;
  537.    if Mvisible then
  538.       Mouse.Show
  539.    else
  540.       Mouse.Hide;
  541.    if Monitor^.ColorOn then
  542.       with Screen do
  543.       begin
  544.          GotoXY(CX,CY);
  545.          CursSize(CT,CB);
  546.       end;
  547. end; {BrowseOBJ.Go}
  548.  
  549. procedure BrowseOBJ.Remove;
  550. {}
  551. begin
  552.    vWin^.Remove;
  553. end; {BrowseOBJ.Remove}
  554.  
  555. function BrowseOBJ.LastKey:word;
  556. {}
  557. begin
  558.    LastKey := vLastKey;
  559. end; {BrowseOBJ.LastKey}
  560.  
  561. procedure BrowseOBJ.ReSetDimensions;
  562. {}
  563. var S: byte;
  564. begin
  565.    with vWin^ do
  566.    begin
  567.       S := GetStyle;
  568.       case S of
  569.       0: vRows := succ(vBorder.Y2 - vBorder.Y1);
  570.       6: vRows := vBorder.Y2 - vBorder.Y1 - 3;
  571.       else vRows := pred(vBorder.Y2 - vBorder.Y1)
  572.       end; {case}
  573.       if S in[0,6] then
  574.          vRealColWidth := succ(vBorder.X2 - vBorder.X1)
  575.       else
  576.          vRealColWidth := pred(vBorder.X2 - vBorder.X1);
  577.    end; {with}
  578. end; {Browse.ResetDimensions}
  579.  
  580. procedure BrowseOBJ.Show;
  581. {}
  582. begin
  583.    if vListAssigned = false then
  584.       Error(1)
  585.    else
  586.    begin
  587.       if not vListVisible then
  588.       begin
  589.          vWin^.Draw;
  590.          ResetDimensions;
  591.          DisplayAllPicks;
  592.          vListVisible := true
  593.       end;
  594.    end;
  595. end; {BrowseOBJ.Show}
  596.  
  597. destructor BrowseOBJ.Done;
  598. {}
  599. begin
  600.    dispose(vWin,Done);
  601. end; {BrowseOBJ.Done}
  602. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  603. {                                                     }
  604. {    B r o w s e A r r a y O B J    M E T H O D S     }
  605. {                                                     }
  606. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  607. constructor BrowseArrayOBJ.Init;
  608. {}
  609. begin
  610.    BrowseObj.Init;
  611. end; {BrowseArrayOBJ.Init}
  612.  
  613. procedure BrowseArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
  614. {}
  615. var
  616.   L : Longint;
  617.   Dummy: byte;
  618.   Result : integer;
  619. begin
  620.    vArrayPtr := @StrArray;
  621.    vStrLength := StrLength;
  622.    vTotPicks := Total;
  623.    vListAssigned := true;
  624.    vEndCol := StrLength;
  625. end; {BrowseArrayOBJ.AssignList}
  626.  
  627. function BrowseArrayOBJ.GetString(Pick, Start,Finish: longint):string;
  628. {}
  629. var
  630.   W : word;
  631.   TempStr : String;
  632.   ArrayOffset: word;
  633. begin
  634.    {move array string to Temp}
  635.    W := pred(Pick) * succ(vStrLength);
  636.    ArrayOffset := Ofs(vArrayPtr^) + W;
  637.    Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  638.    Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  639.    if Start < 0 then Start := 0;
  640.    if Finish < 0 then Finish := 0;
  641.    {validate Start and Finish Parameters}
  642.    if ((Finish = 0) and (Start = 0))
  643.    or (Start > Finish) then   {get full string}
  644.    begin
  645.       Start := 1;
  646.       Finish := 255;
  647.    end
  648.    else if Finish - Start > 254 then      {too long to fit in string}
  649.       Finish := Start + 254;
  650.    if Finish > vStrLength then
  651.       Finish := vStrLength;
  652.    if (Start > vStrLength) then
  653.       GetString := ''
  654.    else
  655.    begin
  656.       GetString := copy(TempStr,Start,succ(Finish - Start));
  657.    end;
  658. end; {BrowseArrayOBJ.GetString}
  659.  
  660. destructor BrowseArrayOBJ.Done;
  661. {}
  662. begin
  663.    BrowseObj.Done;
  664. end; {BrowseArrayOBJ.Done}
  665. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  666. {                                                   }
  667. {    B r o w s e L i n k O B J    M E T H O D S     }
  668. {                                                   }
  669. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  670. constructor BrowseLinkOBJ.Init;
  671. {}
  672. begin
  673.    BrowseObj.Init;
  674.    vLinkList := nil;
  675. end; {BrowseLinkOBJ.Init}
  676.  
  677. procedure BrowseLinkOBJ.AssignList(var LinkList: DLLOBJ);
  678. {}
  679. begin
  680.    vLinkList := @LinkList;
  681.    vTotPicks := LinkList.TotalNodes;
  682.    vListAssigned := true;
  683.    vEndCol := LinkList.GetMaxNodeSize;
  684. end; {BrowseLinkOBJ.AssignList}
  685.  
  686. function BrowseLinkOBJ.GetString(Pick,Start,Finish:longint): string;
  687. {}
  688. var TempPtr : DLLNodePtr;
  689. begin
  690.    TempPtr := vLinkList^.NodePtr(Pick);
  691.    if TempPtr <> Nil then
  692.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  693.    GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
  694. end; {BrowseLinkOBJ.GetString}
  695.  
  696. function BrowseLinkOBJ.ListPtr: DLLPtr;
  697. {}
  698. begin
  699.    ListPtr := vLinkList;
  700. end; {BrowseLinkOBJ.ListPtr}
  701.  
  702. destructor BrowseLinkOBJ.Done; 
  703. {}
  704. begin
  705.    BrowseObj.Done;
  706. end; {BrowseLinkOBJ.Done;}
  707. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  708. {                                                   }
  709. {    B r o w s e F i l e O B J    M E T H O D S     }
  710. {                                                   }
  711. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  712. constructor BrowseFileOBJ.Init;
  713. {}
  714. begin
  715.    BrowseOBJ.Init;
  716. end; {BrowseFileOBJ.Init}
  717.  
  718. function BrowseFileOBJ.AssignFile(Filename: string): integer;
  719. {RetCodes:   
  720.          0   OK
  721.          1   File not found
  722.          2   Run out of memory
  723. }
  724. var
  725.    F : text;
  726.    Line : string;
  727.    Result: integer;
  728. begin
  729.    Assign(F,Filename);
  730.    {$I-}
  731.    Reset(F);
  732.    {$I+}
  733.    if IOResult <> 0 then
  734.       AssignFile := 1
  735.    else
  736.    begin
  737.       new(vStrList,Init);
  738.       Result := 0;
  739.       while (eof(F) = false) and (Result = 0) do
  740.       begin
  741.          Readln(F,Line);
  742.          Result := vStrList^.Add(Line);
  743.       end;
  744.       vWin^.SetTitle(filename);
  745.       vListAssigned := true;
  746.       vTotPicks := vStrList^.TotalNodes;
  747.       vEndCol := vStrList^.GetMaxNodeSize;
  748.       if Result = 0 then
  749.          AssignFile := 0
  750.       else
  751.          AssignFile := 1;
  752.    end;
  753. end; {BrowseFileOBJ.AssignFile}
  754.  
  755. function BrowseFileOBJ.ListPtr:StrDLLPtr;
  756. {}
  757. begin
  758.    ListPtr := vStrList;
  759. end; {BrowseFileOBJ.ListPtr}
  760.  
  761. function BrowseFileOBJ.GetString(Pick,Start,Finish:longint): string;
  762. {}
  763. var TempPtr : DLLNodePtr;
  764. begin
  765.    TempPtr := vStrList^.NodePtr(Pick);
  766.    if TempPtr <> Nil then
  767.       vStrList^.ShiftActiveNode(TempPtr,Pick);
  768.    GetString := vStrList^.GetStr(TempPtr,Start,Finish);
  769. end; {BrowseFileOBJ.GetString}
  770.  
  771. destructor BrowseFileOBJ.Done;   
  772. {}
  773. begin
  774.    BrowseOBJ.Done;
  775.    dispose(vStrList,Done);
  776. end; {BrowseFileOBJ.Done}
  777. {||||||||||||||||||||||||||||||||||||||}
  778. {                                      }
  779. {    L i s t O B J   M E T H O D S     }
  780. {                                      }
  781. {||||||||||||||||||||||||||||||||||||||}
  782. constructor ListOBJ.Init;
  783. {}
  784. begin
  785.    new(vWin,Init);
  786.    vWin^.SetScrollable(true,true);
  787.    vTopPick := 1;
  788.    vTotPicks := 1;
  789.    vActivePick := 1;
  790.    vListVisible := false;
  791.    vListAssigned := false;
  792.    vMsgActive := false;
  793.    vCharHook := NoCharHook;
  794.    vMsgHook := NoMsgHook;
  795.    vAllowToggle  := true;
  796.    vColWidth := 0;
  797.    vHAttr := LookTOT^.MenuHiNorm;
  798.    vNAttr := LookTOT^.MenuLoNorm;
  799.    vSAttr := LookTOT^.MenuOff;
  800.    vWin^.SetColors(0,vNattr,0,0);
  801.    vDualColors := false;
  802. end; {ListOBJ.Init}
  803.  
  804. procedure ListOBJ.SetTopPick(TopPick: longint);
  805. {}
  806. begin
  807.    vTopPick := TopPick;
  808. end; {ListOBJ.SetTopElement}
  809.  
  810. procedure ListOBJ.SetActivePick(ThePick: longint);
  811. {}
  812. begin
  813.    vActivePick := ThePick;
  814. end; {ListOBJ.SetTopElement}
  815.  
  816. procedure ListOBJ.SetTagging(On:boolean);
  817. {}
  818. begin
  819.    vAllowToggle := On;
  820. end; {ListOBJ.SetTagging}
  821.  
  822. procedure ListOBJ.SetDualColors(On:boolean);
  823. {}
  824. begin
  825.    vDualColors := On;
  826. end; {ListOBJ.SetDualColors}
  827.  
  828. procedure ListOBJ.SetColors(HAttr,NAttr,SAttr: byte);
  829. {}
  830. begin
  831.    vHAttr := HAttr;
  832.    vNAttr := NAttr;
  833.    vSAttr := SAttr;
  834.    vWin^.SetColors(0,vNattr,0,0);
  835. end; {ListOBJ.SetColors}
  836.  
  837. procedure ListOBJ.SetColWidth(Wid: byte);
  838. {}
  839. begin
  840.    vColWidth := Wid;
  841. end; {ListOBJ.SetColumnWidth}
  842.  
  843. procedure ListOBJ.SetCharHook(Func:ListCharFunc);
  844. {}
  845. begin
  846.    vCharHook := Func;
  847. end; {ListOBJ.SetCharHook}
  848.  
  849. procedure ListOBJ.SetMsgHook(Func:ListMsgFunc);
  850. {}
  851. begin
  852.    vMsgHook := Func;
  853.    vMsgActive := true;
  854. end; {ListOBJ.SetMsgHook}
  855.  
  856. procedure ListOBJ.SetMsgState(On:boolean);
  857. {}
  858. begin
  859.    vMsgActive := On;
  860. end; {ListOBJ.SetMsgState}
  861.  
  862. function ListOBJ.GetHiString:string;
  863. {}
  864. begin
  865.    GetHiString := GetString(pred(vTopPick+vActivePick),0,0);
  866. end; {ListOBJ.GetHiString}
  867. function ListOBJ.Win:StretchWinPtr;
  868. {}
  869. begin
  870.    Win := vWin;
  871. end; {ListOBJ.Win}
  872.  
  873. procedure ListOBJ.ResetDimensions;
  874. {adjusts the column and row settings based on the list window coords}
  875. var 
  876.   ListWidth: byte;
  877.   Style: byte;
  878. begin
  879.    with vZone do
  880.       vWin^.GetSize(X1,Y1,X2,Y2,Style);
  881.    if Style = 0 then
  882.       fillchar(vMargin,sizeof(vMargin),#0)
  883.    else
  884.    begin
  885.       vMargin.X1 := 1;
  886.       vMargin.X2 := 1;
  887.       vMargin.Y2 := 1;
  888.       if Style = 6 then
  889.          vMargin.Y1 := 3
  890.       else
  891.          vMargin.Y1 := 1;
  892.    end;
  893.    if vColWidth < 5 then
  894.    begin
  895.       vRealColWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
  896.       vCols := 1;
  897.       vLastColWidth := vRealColWidth;
  898.    end
  899.    else
  900.    begin
  901.       vRealColWidth := vColWidth;
  902.       ListWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
  903.       if vRealColWidth > ListWidth then
  904.          vRealColWidth := ListWidth;
  905.       vCols :=  ListWidth div vRealColWidth;
  906.       vLastColWidth := ListWidth - vCols * vRealColWidth;
  907.       if vLastColWidth = 0 then
  908.          vLastColWidth := vRealColWidth
  909.       else
  910.          Inc(vCols);
  911.    end;
  912.    vUseLastCol := (vCols = 1) or (vLastColWidth = vRealColWidth);
  913.    vRows := succ(vZone.Y2 - vZone.Y1) - vMargin.Y1 - vMargin.Y2;
  914.    if vMsgActive then
  915.       dec(vRows,2);  {make space for message}
  916. end; {ListOBJ.ResetDimensions}
  917.  
  918. procedure ListOBJ.DisplayPick(Pick:integer; Hi:boolean);
  919. {}
  920. var
  921.   X,Y,Att,Pad,Max,L: byte;
  922.   W : LongInt;
  923.   Partial,
  924.   Selected: boolean;
  925.   PadLeft,PadRight: string[1];
  926.   PickStr : String;
  927.   LeftChar,
  928.   RightChar,
  929.   ToggleOnChar,
  930.   ToggleOffChar : char;
  931. begin
  932.    if vTotPicks = 0 then
  933.       exit;
  934.    LeftChar := LookTOT^.ListLeftChar;
  935.    RightChar := LookTOT^.ListRightChar;
  936.    ToggleOnChar := LookTOT^.ListToggleOnChar;
  937.    ToggleOffChar := LookTOT^.ListToggleOffChar;
  938.    Partial := (vCols > 1) and (Pick > vRows * Pred(vCols))
  939.                           and (vLastColWidth <> vRealColWidth);
  940.    If pred(vTopPick + Pick) > vTotPicks then
  941.    begin
  942.       Att := vNAttr;
  943.       if not Partial then
  944.          PickStr := replicate(vRealColWidth,' ')
  945.       else
  946.          PickStr := replicate(vLastColWidth,' ');
  947.    end
  948.    else
  949.    begin
  950.       Selected := false;
  951.       Pad := ord(LeftChar<>#0) + 2*ord(vAllowToggle);
  952.       if not Partial then
  953.          Pad := Pad + ord(RightChar<>#0);
  954.       if vAllowToggle then
  955.          Selected := GetStatus(pred(vTopPick+Pick), 0);
  956.       if Hi then
  957.          Att := vHAttr
  958.       else
  959.       begin
  960.          if vDualColors and GetStatus(pred(vTopPick+Pick),1) then
  961.             Att := vSAttr
  962.          else
  963.             Att := vNAttr;
  964.       end;
  965.       if (vCols = 1) or (Pick <= vRows * pred(vCols)) then
  966.       begin
  967.          Max := vRealColWidth;
  968.          W := vRealColWidth - pad;
  969.       end
  970.       else
  971.       begin
  972.          Max := vLastColWidth;
  973.          W := vLastColWidth - pad;
  974.       end;
  975.       if W < 0 then
  976.          PickStr := ''
  977.       else
  978.       begin
  979.          PickStr := GetString(pred(vTopPick + Pick),1,W);
  980.          L := length(PickStr);
  981.          If L < W then {pad out the name}
  982.             PickStr := PickStr + replicate(W-L,' ');
  983.       end;
  984.       if vAllowToggle then
  985.       begin
  986.          if Selected then
  987.             PickStr :=  ToggleOnChar+' '+PickStr
  988.          else
  989.             PickStr :=  ToggleOffChar+' '+PickStr;
  990.       end;
  991.       if Hi then
  992.       begin
  993.         if (LeftChar <> #0) then
  994.            PickStr := LeftChar+PickStr;
  995.         if (RightChar <> #0) then
  996.            PickStr := PickStr+RightChar;
  997.       end
  998.       else
  999.       begin
  1000.          if (LeftChar = #0) then
  1001.             Padleft := ''
  1002.          else
  1003.             PadLeft := ' ';
  1004.          if (RightChar = #0) or Partial then
  1005.             PadRight := ''
  1006.          else
  1007.             PadRight := ' ';
  1008.          PickStr := PadLeft+PickStr+PadRight;
  1009.       end;
  1010.       if length(PickStr) > Max then
  1011.          PickStr := copy(PickStr,1,Max);
  1012.    end;
  1013.    if Pick <= vRows then
  1014.       X := 1
  1015.    else
  1016.       X := succ(vRealColWidth*(pred(Pick) div vRows));
  1017.    if Pick mod vRows = 0 then
  1018.       Y := vRows
  1019.    else
  1020.       Y := (Pick mod vRows);
  1021.    {now write the pick}
  1022.    Screen.WriteAT(X,Y,Att,PickStr);
  1023.    if Hi then
  1024.    begin
  1025.       Screen.GotoXY(X,Y);
  1026.       if vMsgActive then
  1027.       begin
  1028.          PickStr := MessageTask(pred(vTopPick+vActivePick));
  1029.          Screen.WriteAt(1,succ(vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1),
  1030.                         vWin^.GetTitleAttr,
  1031.                         PadCenter(PickStr,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),' '));
  1032.       end;
  1033.    end;
  1034. end; {ListOBJ.DisplayPick}
  1035.  
  1036. procedure ListOBJ.DisplayAllPicks;
  1037. {}
  1038. var
  1039.   I,J:integer;
  1040. begin
  1041.    for I := 1 to vCols do
  1042.       for J := 1 to vRows do
  1043.           DisplayPick(pred(I)*vRows + J,(pred(I)*vRows + J) = vActivePick);
  1044. end; {ListOBJ.DisplayAllPicks}
  1045.  
  1046. procedure ListOBJ.ValidateActivePick;
  1047. {}
  1048. var I,J : Integer;
  1049. begin
  1050.    if (vUseLastCol) or (vCols = 1) then
  1051.       I := vCols*vRows
  1052.    else
  1053.       I := pred(vCols)*vRows;
  1054.    if (vActivePick > I) or (vActivePick < 1) then
  1055.       vActivePick := 1;
  1056. end; {ListOBJ.ValidateActivePick}
  1057.  
  1058. procedure ListOBJ.RefreshList;
  1059. {}
  1060. begin
  1061.    ResetDimensions;
  1062.    ValidateActivePick;
  1063.    if vMsgActive then
  1064.    begin
  1065.       Screen.HorizLine(1,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),
  1066.                          vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1,
  1067.                          Win^.GetBorderAttr,
  1068.                          1);
  1069.    end;
  1070.    DisplayAllPicks;
  1071. end; {ListOBJ.RefreshList}
  1072.  
  1073. procedure ListOBJ.ScrollDown;
  1074. {}
  1075. var LastPick : integer;
  1076. begin
  1077.    if pred(vTopPick + vActivePick) < vTotPicks then {not end of list}
  1078.    begin
  1079.       if (vUseLastCol) or (vCols = 1) then
  1080.          LastPick := vCols*vRows
  1081.       else
  1082.          LastPick := pred(vCols)*vRows;
  1083.       if vActivePick < LastPick then
  1084.       begin
  1085.          DisplayPick(vActivePick,false);
  1086.          inc(vActivePick);
  1087.          DisplayPick(vActivePick,True);
  1088.       end
  1089.       else
  1090.       begin
  1091.          inc(vTopPick);
  1092.          DisplayAllPicks;
  1093.       end;
  1094.    end;
  1095. end; {ListOBJ.ScrollDown}
  1096.  
  1097. procedure ListOBJ.ScrollUp;
  1098. {}
  1099. begin
  1100.    if vActivePick = 1 then
  1101.    begin
  1102.       if vTopPick > 1 then
  1103.       begin
  1104.          dec(vTopPick);
  1105.          DisplayAllPicks;
  1106.       end;
  1107.    end
  1108.    else
  1109.    begin
  1110.       DisplayPick(vActivePick,false);
  1111.       dec(vActivePick);
  1112.       DisplayPick(vActivePick,True);
  1113.    end;
  1114. end; {ListOBJ.ScrollUp}
  1115.  
  1116. procedure ListObj.JumpEngine(Tot, NewValue: longint);
  1117. {}
  1118. var I: Integer;
  1119. begin
  1120.    if NewValue < 1 then
  1121.       NewValue := 1;
  1122.    if (Tot < (vCols - ord(not vUseLastCol)) * vRows)
  1123.    and (vTopPick <= NewValue) then {full list on display}
  1124.    begin
  1125.       DisplayPick(vActivePick,false);
  1126.       vActivePick := NewValue - pred(vTopPick);
  1127.       DisplayPick(vActivePick,True);
  1128.    end
  1129.    else
  1130.    begin
  1131.       vTopPick := NewValue;
  1132.       vActivePick := 1;
  1133.       DisplayAllPicks;
  1134.    end;
  1135. end; {JumpEngine}
  1136.  
  1137. procedure ListOBJ.ScrollJumpV(X,Y:byte);
  1138. {}
  1139. var
  1140.   NewValue: LongInt;
  1141. begin
  1142.    NewValue := (X * vTotPicks) div Y;
  1143.    JumpEngine(vTotPicks,NewValue)
  1144. end; {ListOBJ.ScrollJumpV}
  1145.  
  1146. procedure ListOBJ.ScrollJumpH(X,Y:byte);
  1147. {}
  1148. var
  1149.   NewValue: LongInt;
  1150. begin
  1151.    NewValue := (X * vTotPicks) div Y;
  1152.    JumpEngine(vTotPicks,NewValue)
  1153. end; {ListOBJ.ScrollJumpH}
  1154.  
  1155. procedure ListOBJ.ScrollLeft;
  1156. {}
  1157. begin
  1158.    if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
  1159.       ScrollUp
  1160.    else
  1161.       if vActivePick > vRows then {not in first column}
  1162.       begin
  1163.          DisplayPick(vActivePick,false);
  1164.          vActivePick := vActivePick - vRows;
  1165.          DisplayPick(vActivePick,True);
  1166.       end
  1167.       else if vTopPick > vRows then                      {leftmost column}
  1168.       begin
  1169.          vTopPick := vTopPick - vRows;
  1170.          DisplayAllPicks;
  1171.       end
  1172.       else
  1173.       begin
  1174.          vTopPick := 1;
  1175.          vActivePick := 1;
  1176.          DisplayAllPicks;
  1177.       end;
  1178. end; {ListOBJ.ScrollLeft}
  1179.  
  1180. procedure ListOBJ.ScrollRight;
  1181. {}
  1182. begin
  1183.    if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
  1184.       ScrollDown
  1185.    else
  1186.       if (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) {not in last column}
  1187.       or (vTopPick + (vRows*(vCols -ord(not vUseLastCol))) >= vTotPicks) then
  1188.       begin
  1189.          DisplayPick(vActivePick,false);
  1190.          vActivePick := vActivePick + vRows;
  1191.          if vTopPick + pred(vActivePick) > vTotPicks then
  1192.             vActivePick := succ(vTotPicks - vTopPick);
  1193.          DisplayPick(vActivePick,True);
  1194.       end
  1195.       else 
  1196.       begin
  1197.          vTopPick := vTopPick + vRows;
  1198.          if vTopPick + pred(vActivePick) > vTotPicks then
  1199.            vActivePick := succ(vTotPicks - vTopPick);
  1200.          DisplayAllPicks;
  1201.       end;
  1202. end; {ListOBJ.ScrollRight}
  1203.  
  1204. procedure ListOBJ.ScrollFarRight;
  1205. {}
  1206. begin
  1207.    while (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) do
  1208.       inc(vActivePick,vRows);
  1209.    while (vTopPick + (vCols -ord(not vUseLastCol)) * vRows < vTotPicks)
  1210.    and   (vTopPick + pred(vActivePick) + vRows <= vTotPicks) do
  1211.       inc(vTopPick,vRows);
  1212.    DisplayAllPicks;
  1213. end; {ListOBJ.ScrollFarRight}
  1214.  
  1215. procedure ListOBJ.ScrollFarLeft;
  1216. {}
  1217. begin
  1218.    while vActivePick - vRows > 0 do
  1219.      dec(vActivePick,vRows);
  1220.    vTopPick := 1;
  1221.    DisplayAllPicks;
  1222. end; {ListOBJ.ScrollFarLeft}
  1223.  
  1224. procedure ListOBJ.ScrollPgDn;
  1225. {}
  1226. begin
  1227.    if pred(vTopPick + vRows) < vTotPicks then
  1228.    begin
  1229.       vTopPick := vTopPick + vRows;
  1230.       vActivePick := 1;
  1231.       DisplayAllPicks;
  1232.    end;
  1233. end; {ListOBJ.ScrollPgDn}
  1234.  
  1235. procedure ListOBJ.ScrollPgUp;
  1236. {}
  1237. begin
  1238.    if vTopPick > 1 then
  1239.    begin
  1240.       vTopPick := vTopPick - vRows;
  1241.       if vTopPick < 1 then
  1242.          vTopPick := 1;
  1243.       DisplayAllPicks;
  1244.    end;
  1245. end; {ListOBJ.ScrollPgUp}
  1246.  
  1247. procedure ListOBJ.ScrollLast;
  1248. {}
  1249. begin
  1250.    if vTopPick + pred((vCols -ord(not vUseLastCol)) * vRows) >= vTotPicks then {last node on display}
  1251.    begin
  1252.       DisplayPick(vActivePick,False);
  1253.       vActivePick := succ(vTotPicks - vTopPick);
  1254.       DisplayPick(vActivePick,True);
  1255.    end
  1256.    else
  1257.    begin
  1258.      vTopPick := vTotPicks;
  1259.      vActivePick := 1;
  1260.      DisplayAllPicks;
  1261.    end;
  1262. end; {ListOBJ.ScrollLast}
  1263.  
  1264. procedure ListOBJ.ScrollFirst;
  1265. {}
  1266. begin
  1267.    vTopPick := 1;
  1268.    vActivePick := 1;
  1269.    DisplayAllPicks;
  1270. end; {ListOBJ.ScrollFirst}
  1271.  
  1272. procedure ListOBJ.ToggleSelect;
  1273. {}
  1274. begin
  1275.    SetStatus(pred(vTopPick+vActivePick), 0,not GetStatus(pred(vTopPick+vActivePick),0));
  1276.    if pred(vTopPick + vActivePick) < vTotPicks then
  1277.       ScrollDown
  1278.    else
  1279.       DisplayPick(vActivePick,True);
  1280. end; {of ListOBJ.ToggleSelect}
  1281.  
  1282. function ListOBJ.TargetPick(X,Y:byte): Integer;
  1283. {return the pick number of the pick pointed to by
  1284.  the coordinates X,Y. If no pick is at those coordinates, a
  1285.  0 is returned}
  1286. begin
  1287.    if  (X >= vZone.X1 + vMargin.X1)
  1288.    and (X <= vZone.X2 - vMargin.X2)
  1289.    and (Y >= vZone.Y1 + vMargin.Y1)
  1290.    and (Y <= vZone.Y1 + vMargin.Y1 + pred(vRows))
  1291.    then
  1292.    begin
  1293.       X := succ(X - vZone.X1 - vMargin.X1);
  1294.       Y := succ(Y - vZone.Y1 - vMargin.Y1);
  1295.       if X mod vRealColWidth = 0 then
  1296.          X := X div vRealColWidth
  1297.       else
  1298.          X := succ(X div vRealColWidth);
  1299.       if (X < vCols)
  1300.       or ((X = vCols) and vUseLastCol) then
  1301.       begin
  1302.           if vTopPick + pred(pred(X)*vRows + Y) <= vTotPicks then
  1303.           begin
  1304.              TargetPick := pred(X)*vRows + Y;
  1305.              exit;
  1306.           end;
  1307.       end;
  1308.    end;
  1309.    TargetPick := 0;
  1310. end; {ListOBJ.TargetPick}
  1311.  
  1312. procedure ListOBJ.MouseChoose(KeyX,KeyY:byte);
  1313. {}
  1314. var
  1315.    HitPick : integer;
  1316. begin
  1317.    HitPick := TargetPick(KeyX,KeyY);
  1318.    if HitPick <> 0 then
  1319.    begin
  1320.       DisplayPick(vActivePick,false);
  1321.       vActivePick := HitPick;
  1322.       SetStatus(pred(vTopPick+vActivePick),0,not GetStatus(pred(vTopPick+vActivePick),0));
  1323.       DisplayPick(vActivePick,True);
  1324.    end;
  1325. end; {ListOBJ.MouseChoose}
  1326.  
  1327. procedure ListOBJ.Show;
  1328. {}
  1329. begin
  1330.    if vListAssigned = false then
  1331.       Error(1)
  1332.    else
  1333.    begin
  1334.       if not vListVisible then
  1335.       begin
  1336.          vWin^.Draw;
  1337.          RefreshList;
  1338.          vListVisible := true
  1339.       end;
  1340.    end;
  1341. end; {ListOBJ.Show}
  1342.  
  1343. procedure ListOBJ.Go;
  1344. {}
  1345. var
  1346.    Finished: boolean;
  1347.    Mvisible: boolean;
  1348.    Kdouble: boolean;
  1349.    K: word;
  1350.    X,Y :byte;
  1351.    CursX,CursY: byte;
  1352.    Msg : string;
  1353.    CX,CY,CT,CB:byte;
  1354.  
  1355.        procedure ProcessAction(Act: tListAction);
  1356.        {}
  1357.        begin
  1358.           case Act of
  1359.              Finish: begin
  1360.                 K := 0;
  1361.                 Finished := true;
  1362.                 end;
  1363.              Refresh: begin
  1364.                 K := 0;
  1365.                 RefreshList;
  1366.                 end;
  1367.              None:; {nothing!}
  1368.           end; {case}
  1369.        end; {ProcessAction}
  1370.  
  1371. begin
  1372.    if Monitor^.ColorOn then
  1373.       with Screen do
  1374.       begin
  1375.          CursSave;
  1376.          CX := WhereX;
  1377.          CY := WhereY;
  1378.          CT := CursTop;
  1379.          CB := CursBot;
  1380.          CursOff;
  1381.       end;
  1382.    Mvisible := Mouse.Visible;
  1383.    Show;
  1384.    kDouble := Key.GetDouble;
  1385.    if not kDouble then
  1386.       Key.SetDouble(true);
  1387.    Mouse.Show;
  1388.    Finished := false;
  1389.    repeat
  1390.       CursX := Screen.WhereX;
  1391.       CursY := Screen.WhereY;
  1392.       vWin^.DrawHorizBar(pred(vTopPick+vActivePick),vTotPicks);
  1393.       vWin^.DrawVertBar(pred(vTopPick+vActivePick),vTotPicks);
  1394.       Screen.GotoXY(CursX,CursY);
  1395.       K := Key.GetKey;
  1396.       X := Key.LastX;
  1397.       Y := Key.LastY;
  1398.       vWin^.Winkey(K,X,Y);
  1399.       ProcessAction(CharTask(K,X,Y,pred(vTopPick+vActivePick)));
  1400.       if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
  1401.          Finished := true
  1402.       else if (K = LookTOT^.ListToggleKey) and vAllowToggle then
  1403.          ToggleSelect
  1404.       else if (K = LookTOT^.ListTagKey) and vAllowToggle then
  1405.          TagAll(true)
  1406.       else if (K = LookTOT^.ListUnTagKey) and vAllowToggle then
  1407.          TagAll(false)
  1408.       else
  1409.          case K of
  1410.          13: if vAllowToggle = false then
  1411.                 Finished := true
  1412.              else
  1413.                 ToggleSelect;
  1414.          600: Finished := true; {window close}
  1415.          601: ResetDimensions;
  1416.          602: RefreshList;
  1417.          610,328: ScrollUp;
  1418.          611,336: ScrollDown;
  1419.          612,331: ScrollLeft;
  1420.          613,333: ScrollRight;
  1421.          513: MouseChoose(X,Y);  {leftMouse}
  1422.          523: if TargetPick(X,Y) <> 0 then
  1423.                begin
  1424.                   MouseChoose(X,Y);
  1425.                   Finished := True;
  1426.                end;
  1427.          337: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgDn}
  1428.                  ScrollPgDn
  1429.               else
  1430.                  ScrollRight;
  1431.          329: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgUp}
  1432.                  ScrollPgUp
  1433.               else
  1434.                  ScrollLeft;
  1435.          335: ScrollFarRight;
  1436.          327: ScrollFarLeft;
  1437.          388: ScrollFirst;
  1438.          374: ScrollLast;
  1439.          614: begin  {vertical scroll bar}
  1440.                  if X = 1 then
  1441.                     ScrollFirst
  1442.                  else if X = Y then
  1443.                     ScrollLast
  1444.                  else
  1445.                     ScrollJumpV(X,Y); {vertical scroll bar}
  1446.               end;
  1447.          615: begin {horizontal scroll bar}
  1448.                  if X = 1 then
  1449.                     ScrollFirst
  1450.                  else if X = Y then
  1451.                     ScrollLast
  1452.                  else
  1453.                     ScrollJumpH(X,Y); {vertical scroll bar}
  1454.               end;
  1455.          end; {case}
  1456.    until Finished;
  1457.    vLastKey := K;
  1458.    if Mvisible then
  1459.       Mouse.Show
  1460.    else
  1461.       Mouse.Hide;
  1462.    if Monitor^.ColorOn then
  1463.       with Screen do
  1464.       begin
  1465.          GotoXY(CX,CY);
  1466.          CursSize(CT,CB);
  1467.       end;
  1468.    Key.SetDouble(KDouble);
  1469. end; {ListOBJ.Go}
  1470.  
  1471. function ListOBJ.LastKey:word;
  1472. {}
  1473. begin
  1474.    LastKey := vLastKey;
  1475. end; {ListOBJ.LastKey}
  1476.  
  1477. procedure ListOBJ.Remove;
  1478. {}
  1479. begin
  1480.    vWin^.Remove;
  1481. end; {ListOBJ.Remove}
  1482.  
  1483. function ListOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction; 
  1484. {}
  1485. begin
  1486.    CharTask := vCharHook(K,X,Y,HiPick);
  1487. end; {ListOBJ.CharTask}
  1488.  
  1489. function ListOBJ.MessageTask(HiPick:longint):string; 
  1490. {}
  1491. begin
  1492.    MessageTask := vMsgHook(HiPick);
  1493. end; {ListOBJ.MessageTask}
  1494.  
  1495. function ListOBJ.GetString(Pick, Start,Finish: longint):string;
  1496. {abstract}
  1497. begin end;
  1498.  
  1499. function ListOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1500. {abstract}
  1501. begin end;
  1502.  
  1503. procedure ListObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1504. {abstract}
  1505. begin end;
  1506.  
  1507. procedure ListOBJ.TagAll(On:boolean);
  1508. {}
  1509. begin end;
  1510.  
  1511. destructor ListOBJ.Done;
  1512. {}
  1513. begin
  1514.    dispose(vWin,Done);
  1515. end;  {ListOBJ.Done}
  1516. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  1517. {                                                 }
  1518. {    L i s t A r r a y O B J    M E T H O D S     }
  1519. {                                                 }
  1520. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  1521. constructor ListArrayOBJ.Init;
  1522. {}
  1523. begin
  1524.    ListObj.Init;
  1525.    vLinkList := Nil;
  1526. end; {ListArrayOBJ.Init}
  1527.  
  1528. procedure ListArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte; Selectable: boolean);
  1529. {}
  1530. var
  1531.   L : Longint;
  1532.   Dummy: byte;
  1533.   Result : integer;
  1534. begin
  1535.    vArrayPtr := @StrArray;
  1536.    vStrLength := StrLength;
  1537.    vTotPicks := Total;
  1538.    vListAssigned := true;
  1539.    vAllowToggle := Selectable;
  1540.    if vAllowToggle then {assign a linked list to record selections}
  1541.    begin
  1542.       if MemAvail < SizeOf(vLinkList^) then
  1543.       begin
  1544.          vAllowToggle := False;
  1545.          exit;
  1546.       end;
  1547.       New(vLinkList,Init);
  1548.       with vLinkList^ do
  1549.       begin
  1550.          Dummy := 0;
  1551.          For L := 1 to Total do
  1552.          begin
  1553.             Result := Add(Dummy,0);
  1554.             if Result <> 0 then
  1555.             begin
  1556.                Dispose(vLinkList,Done);
  1557.                vAllowToggle := false;
  1558.             end;
  1559.          end;
  1560.       end;
  1561.    end;
  1562. end; {ListArrayOBJ.AssignList}
  1563.  
  1564. procedure ListArrayOBJ.SetTagging(On:boolean);
  1565. {}
  1566. begin
  1567.    if On and (vLinkList <> Nil) then
  1568.       vAllowToggle := true
  1569.    else
  1570.       vAllowToggle := false;
  1571. end; {ListOBJ.SetTagging}
  1572.  
  1573. function ListArrayOBJ.GetString(Pick, Start,Finish: longint):string;
  1574. {}
  1575. var
  1576.   W : longint;
  1577.   TempStr : String;
  1578.   ArrayOffset: word;
  1579. begin
  1580.    {move array string to Temp}
  1581.    W := pred(Pick) * succ(vStrLength);
  1582.    ArrayOffset := Ofs(vArrayPtr^) + W;
  1583.    Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  1584.    Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  1585.    if Start < 0 then Start := 0;
  1586.    if Finish < 0 then Finish := 0;
  1587.    {validate Start and Finish Parameters}
  1588.    if ((Finish = 0) and (Start = 0))
  1589.    or (Start > Finish) then   {get full string}
  1590.    begin
  1591.       Start := 1;
  1592.       Finish := 255;
  1593.    end
  1594.    else if Finish - Start > 254 then      {too long to fit in string}
  1595.       Finish := Start + 254;
  1596.    if Finish > vStrLength then
  1597.       Finish := vStrLength;
  1598.    if (Start > vStrLength) then
  1599.       GetString := ''
  1600.    else
  1601.    begin
  1602.       GetString := copy(TempStr,Start,succ(Finish - Start));
  1603.    end;
  1604. end; {ListArrayOBJ.GetString}
  1605.  
  1606. function ListArrayOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1607. {}
  1608. begin
  1609.    GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos);
  1610. end; {ListArrayOBJ.GetStatus}
  1611.  
  1612. procedure ListArrayObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1613. {}
  1614. begin
  1615.    vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1616. end; {ListArrayObj.SetStatus}
  1617.  
  1618. procedure ListArrayOBJ.TagAll(On:boolean);
  1619. {}
  1620. var NodeP : DLLNodePtr;
  1621. begin
  1622.    NodeP := vLinkList^.StartNodePtr;
  1623.    while NodeP <> Nil do
  1624.    begin
  1625.       NodeP^.SetStatus(0,On);
  1626.       NodeP := NodeP^.NextPtr;
  1627.    end;
  1628.    DisplayAllPicks;
  1629. end; {ListOBJ.TagAll}
  1630.  
  1631. destructor ListArrayOBJ.Done;
  1632. {}
  1633. begin
  1634.    if vLinkList <> nil then
  1635.       Dispose(vLinkList,Done);
  1636.    ListObj.Done;
  1637. end; {ListArrayOBJ.Done}
  1638. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1639. {                                               }
  1640. {    L i s t L i n k O B J    M E T H O D S     }
  1641. {                                               }
  1642. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1643. constructor ListLinkOBJ.Init;
  1644. {}
  1645. begin
  1646.    ListObj.Init;
  1647.    vLinkList := nil;
  1648. end; {ListLinkOBJ.Init}
  1649.  
  1650. procedure ListLinkOBJ.AssignList(var LinkList: DLLOBJ);
  1651. {}
  1652. begin
  1653.    vLinkList := @LinkList;
  1654.    vTotPicks := LinkList.TotalNodes;
  1655.    vListAssigned := true;
  1656. end; {ListLinkOBJ.AssignList}
  1657.  
  1658. function ListLinkOBJ.ListPtr: DLLPtr;
  1659. {}
  1660. begin
  1661.    ListPtr := vLinkList;
  1662. end; {ListLinkOBJ.ListPtr}
  1663.  
  1664. function ListLinkOBJ.GetString(Pick, Start,Finish: longint):string;
  1665. {}
  1666. var TempPtr : DLLNodePtr;
  1667. begin
  1668.    TempPtr := vLinkList^.NodePtr(Pick);
  1669.    if TempPtr <> Nil then
  1670.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  1671.    GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
  1672. end; {ListLinkOBJ.GetString}
  1673.  
  1674. function ListLinkOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1675. {}
  1676. begin
  1677.    GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos);
  1678. end; {ListLinkOBJ.GetStatus}
  1679.  
  1680. procedure ListLinkObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1681. {}
  1682. begin
  1683.    vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1684. end;  {ListLinkObj.SetStatus}
  1685.  
  1686. procedure ListLinkOBJ.TagAll(On:boolean);
  1687. {}
  1688. var NodeP : DLLNodePtr;
  1689. begin
  1690.    NodeP := vLinkList^.StartNodePtr;
  1691.    while NodeP <> Nil do
  1692.    begin
  1693.       NodeP^.SetStatus(0,On);
  1694.       NodeP := NodeP^.NextPtr;
  1695.    end;
  1696.    DisplayAllPicks;
  1697. end; {ListOBJ.TagAll}
  1698.  
  1699. destructor ListLinkOBJ.Done;
  1700. {}
  1701. begin
  1702.    ListObj.Done;
  1703. end; {ListLinkOBJ.Done}
  1704. {|||||||||||||||||||||||||||||||||||||||||||||}
  1705. {                                             }
  1706. {    L i s t D i r O B J    M E T H O D S     }
  1707. {                                             }
  1708. {|||||||||||||||||||||||||||||||||||||||||||||}
  1709. constructor ListDirOBJ.Init;
  1710. {}
  1711. begin
  1712.    ListObj.Init;
  1713.    new(vFileList,Init);
  1714.    vMsgActive := true;
  1715.    vDualColors := true;
  1716.    vColWidth := 15;
  1717.    vWin^.SetSize(10,5,71,20,1);
  1718. end; {ListDirOBJ.Init}
  1719.  
  1720. procedure ListDirOBJ.ReadFiles(FileMasks:string; FileAttrib: word);
  1721. {}
  1722. begin
  1723.    if FileMasks = '' then
  1724.       FileMasks := '*.*';
  1725.    vFileList^.SetFileDetails(FileMasks,FileAttrib);
  1726.    if (pos(':',Filemasks)=0) and (pos('\',Filemasks)=0) then 
  1727.    begin
  1728.       GetDir(0,vActiveDir);
  1729.       if not (vActiveDir[length(vActiveDir)] in [':','\']) then
  1730.          vActiveDir := vActiveDir + '\';
  1731.       Filemasks := vActiveDir+Filemasks;
  1732.    end;
  1733.    Win^.SetTitle(FileMasks);
  1734.    vFileList^.FillList;
  1735.    vTotPicks := vFileList^.TotalNodes;
  1736.    vListAssigned := true;
  1737. end; {ListDirOBJ.ReadFiles}
  1738.  
  1739. function ListDirOBJ.GetString(Pick, Start,Finish: longint):string;
  1740. {}
  1741. var TempPtr : DLLNodePtr;
  1742. begin
  1743.    TempPtr := vFileList^.NodePtr(Pick);
  1744.    if TempPtr <> Nil then
  1745.       vFileList^.ShiftActiveNode(TempPtr,Pick);
  1746.    GetString := vFileList^.GetStr(TempPtr,Start,Finish);
  1747. end; {ListDirOBJ.GetString}
  1748.  
  1749. function ListDirOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
  1750. {}
  1751. var
  1752.   FileInfo: tFileInfo;
  1753.   HitPick : integer;
  1754. begin
  1755.    CharTask := none;
  1756.    if (K = 13) or (K = 513) then
  1757.    begin
  1758.       if K = 513 then
  1759.       begin
  1760.          HitPick := TargetPick(X,Y);
  1761.          if HitPick <> 0 then
  1762.             HiPick := pred(vTopPick+HitPick)
  1763.          else
  1764.             exit;
  1765.       end;
  1766.       vFileList^.GetFileRecord(FileInfo,HiPick);
  1767.       if SubDirectory(FileInfo.Attr) then
  1768.       begin
  1769.          {$I-}
  1770.          ChDir(FileInfo.FileName);
  1771.          {$I+}
  1772.          if IOResult = 0 then
  1773.          begin
  1774.             vFileList^.FillList;
  1775.             vTotPicks := vFileList^.TotalNodes;
  1776.             vTopPick := 1;
  1777.             vActivePick := 1;
  1778.             CharTask := Refresh;
  1779.             GetDir(0,vActiveDir);
  1780.             if not (vActiveDir[length(vActiveDir)] in [':','\']) then
  1781.                vActiveDir := vActiveDir + '\';
  1782.             Win^.SetTitle(vActiveDir+vFileList^.GetFileMask);
  1783.             Win^.Refresh;
  1784.          end;
  1785.       end
  1786.       else if (K= 13) or ((K=513) and (vAllowToggle = false)) then
  1787.          CharTask := Finish;
  1788.    end;
  1789. end; {ListDirOBJ.CharTask}
  1790.  
  1791. function ListDirOBJ.GetHiString:string;
  1792. {}
  1793. begin
  1794.    GetHiString := vActiveDir + GetString(pred(vTopPick+vActivePick),0,0);
  1795. end; {ListDirOBJ.GetHiString}
  1796.  
  1797. function ListDirOBJ.MessageTask(Hi:longint): string;
  1798. {}
  1799. var TempPtr : DLLNodePtr;
  1800. begin
  1801.    TempPtr := vFileList^.NodePtr(Hi);
  1802.    if TempPtr <> Nil then
  1803.       vFileList^.ShiftActiveNode(TempPtr,Hi);
  1804.    MessageTask := vFileList^.GetLongStr(TempPtr);
  1805. end; {ListDirOBJ.MessageTask}
  1806.  
  1807. function ListDirOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1808. {}
  1809. begin
  1810.    GetStatus := vFileList^.NodePtr(Pick)^.GetStatus(BitPos);
  1811. end; {ListDirOBJ.GetStatus}
  1812.  
  1813. procedure ListDirObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1814. {}
  1815. begin
  1816.    vFileList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1817. end;  {ListDirObj.SetStatus}
  1818.  
  1819. procedure ListDirOBJ.TagAll(On:boolean);
  1820. {}
  1821. var NodeP : DLLNodePtr;
  1822. begin
  1823.    NodeP := vFileList^.StartNodePtr;
  1824.    while NodeP <> Nil do
  1825.    begin
  1826.       NodeP^.SetStatus(0,On);
  1827.       NodeP := NodeP^.NextPtr;
  1828.    end;
  1829.    DisplayAllPicks;
  1830. end; {ListOBJ.TagAll}
  1831.  
  1832. function ListDirOBJ.FileList: FileDLLPtr;
  1833. {}
  1834. begin
  1835.    FileList := vFileList;
  1836. end; {ListDirOBJ.FileList}
  1837.  
  1838. procedure ListDirOBJ.Go;
  1839. {}
  1840. var
  1841.   D: string;
  1842. begin
  1843.    GetDir(0,D);
  1844.    ListOBJ.Go;
  1845.    {$I-}
  1846.    ChDir(D);
  1847.    {$I+}
  1848.    if IOResult <> 0 then
  1849.       {whogivesashit};
  1850. end; {ListDirOBJ.Go}
  1851.  
  1852. destructor ListDirOBJ.Done;
  1853. {}
  1854. begin
  1855.    ListObj.Done;
  1856.    dispose(vFileList,Done);
  1857. end; {ListDirOBJ.Done}
  1858. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1859. {                                                     }
  1860. {    L i s t D i r S o r t O B J    M E T H O D S     }
  1861. {                                                     }
  1862. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1863. constructor ListDirSortOBJ.Init;
  1864. {}
  1865. begin
  1866.    ListDirObj.Init;
  1867. end; {ListDirSortOBJ.Init}
  1868.  
  1869. function ListDirSortOBJ.PromptAndSort: boolean;
  1870. {}
  1871. var
  1872.   Manager: WinFormOBJ;
  1873.   Control:  ControlKeysIOOBJ;
  1874.   OK,Cancel: Strip3DIOOBJ;
  1875.   SField,SOrder: RadioIOOBJ;
  1876.   Result: tAction;
  1877.   SortField: byte;
  1878.   SortOrder: boolean;
  1879. begin
  1880.    Control.Init; {Tab, STab, Enter, Esc}
  1881.    OK.Init(23,5,'   ~O~K   ',Finished);
  1882.    OK.SetHotKey(79);{O}
  1883.    Cancel.Init(23,8,' ~C~ancel ',Escaped);
  1884.    Cancel.SetHotKey(67); {C}
  1885.    with SField do
  1886.    begin
  1887.       Init(3,2,18,6,'Sort on:');
  1888.       AddItem('Nat~u~ral DOS',ord('U'),vFileList^.vSortID = 0);
  1889.       AddItem('~N~ame',ord('N'),vFileList^.vSortID = 1);
  1890.       AddItem('~E~xt', ord('E'),vFileList^.vSortID = 2);
  1891.       AddItem('~S~ize',ord('S'),vFileList^.vSortID = 3);
  1892.       AddItem('~T~ime',ord('T'),vFileList^.vSortID = 4);
  1893.       SetID(1);
  1894.    end;
  1895.    with SOrder do
  1896.    begin
  1897.       Init(3,9,18,3,'Sort Order:');
  1898.       AddItem('~A~scending',ord('A'),vFileList^.vSortAscending);
  1899.       AddItem('~D~escending',ord('D'),not vFileList^.vSortAscending);
  1900.    end;
  1901.    with Manager do
  1902.    begin
  1903.      Init;
  1904.      AddItem(Control);
  1905.      AddItem(SField);
  1906.      AddItem(SOrder);
  1907.      AddItem(OK);
  1908.      AddItem(Cancel);
  1909.      SetActiveItem(1);
  1910.      Win^.SetSize(25,2,58,15,1);
  1911.      Win^.SetTitle('Directory Sort Options');
  1912.      Draw;
  1913.      Result := Go;
  1914.      SortField := pred(Sfield.GetValue);
  1915.      SortOrder := (SOrder.GetValue = 1);
  1916.      Control.Done;
  1917.      OK.Done;
  1918.      Cancel.Done;
  1919.      SField.Done;
  1920.      SOrder.Done;
  1921.      Done;
  1922.    end;
  1923.    if Result = Finished then
  1924.    begin
  1925.       vFileList^.Sort(SortField,SortOrder);
  1926.       vTopPick := 1;
  1927.       vActivePick := 1;
  1928.       PromptAndSort := true;
  1929.    end
  1930.    else
  1931.       PromptAndSort := false;
  1932. end; {ListDirSortOBJ.PromptAndSort}
  1933.  
  1934. function ListDirSortOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
  1935. {}
  1936. var
  1937.   FileInfo: tFileInfo;
  1938.   D : string;
  1939.   MP: longint;
  1940. begin
  1941.    CharTask := none;
  1942.    if (K = 83) or (K = 115) or (K = 514) then {'S','s',rightbutton}
  1943.    begin
  1944.       if PromptAndSort then
  1945.          CharTask := Refresh
  1946.       else
  1947.          CharTask := none;
  1948.    end
  1949.    else
  1950.       CharTask := ListDirOBJ.CharTask(K,X,Y,HiPick);
  1951. end; {ListDirSortOBJ.CharTask}
  1952.  
  1953. destructor ListDirSortOBJ.Done;
  1954. {}
  1955. begin
  1956.    ListDirObj.Done;
  1957. end; {ListDirSortOBJ.Done}
  1958. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1959. {                                               }
  1960. {     U N I T   I N I T I A L I Z A T I O N     }
  1961. {                                               }
  1962. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1963.  
  1964. procedure ListInit;
  1965. {initilizes objects and global variables}
  1966. begin
  1967. end;
  1968.  
  1969. {end of unit - add initialization routines below}
  1970. {$IFNDEF OVERLAY}
  1971. begin
  1972.    ListInit;
  1973. {$ENDIF}
  1974. end.
  1975.  
  1976.  
  1977.  
  1978.